Phylogenetic diversity in other problems - GPTP 2021
Emily Dolson
Other fitness landscapes
Setup
library(ggplot2)
library(tidyverse)
library(knitr)
library(cowplot)
library(viridis)
library(RColorBrewer)
library(rstatix)
library(ggsignif)
library(Hmisc)
library(kableExtra)
source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")
library(readr)
library(stringr)
library(ggpubr)
library(infotheo)
library(osfr)
library(scales)These analyses were conducted in the following computing environment:
print(version)## _
## platform x86_64-pc-linux-gnu
## arch x86_64
## os linux-gnu
## system x86_64, linux-gnu
## status
## major 4
## minor 0.4
## year 2021
## month 02
## day 15
## svn rev 80002
## language R
## version.string R version 4.0.4 (2021-02-15)
## nickname Lost Library Book# Labeler for stats annotations
p_label <- function(p_value) {
threshold = 0.0001
if (p_value < threshold) {
return(paste0("p < ", threshold))
} else {
return(paste0("p = ", p_value))
}
}
# Significance threshold
alpha <- 0.05
####### misc #######
# Configure our default graphing theme
theme_set(theme_cowplot())osf_retrieve_file("p79hx") %>% osf_download(conflicts = "skip") # Download data from osf## # A tibble: 1 x 4
## name id local_path meta
## <chr> <chr> <chr> <list>
## 1 complex_fitness_lands… 612fe4d84e5ee501… ./complex_fitness_lands… <named list…data_loc <- "complex_fitness_landscapes.csv"
data <- read_csv(data_loc, na=c("NONE", "NA", ""))
data <- data %>%
filter(N==20, generation %%10 == 0) %>%
mutate(
selection_name = as.factor(case_when(
SELECTION == 0 ~ "Tournament",
SELECTION == 1 ~ "Fitness sharing",
SELECTION == 2 ~ "Lexicase",
SELECTION == 3 ~ "Eco-EA",
SELECTION == 4 ~ "Random",
)),
problem_name = as.factor(case_when(
PROBLEM == 0 ~ "NK Landscape",
PROBLEM == 1 ~ "Count Odds",
PROBLEM == 2 ~ "Real-valued optimization",
PROBLEM == 3 ~ "Sorting network",
PROBLEM == 4 ~ "Logic-9"
))
)
data <- filter(data, generation <= 2000)
final_data <- filter(data, generation==max(data$generation))Performance
Over time
ggplot(
data,
aes(
x=generation,
y=max_performance,
color=selection_name,
fill=selection_name
)
) +
stat_summary(geom="line", fun=mean) +
stat_summary(
geom="ribbon",
fun.data="mean_cl_boot",
fun.args=list(conf.int=0.95),
alpha=0.2,
linetype=0
) +
scale_y_continuous(
name="Average trait performance"
) +
scale_x_continuous(
name="Generation"
) +
scale_color_discrete("Selection") +
scale_fill_discrete("Selection") +
facet_wrap(~problem_name, scales="free")
Final
# Compute manual labels for geom_signif
stat.test <- final_data %>%
wilcox_test(max_performance ~ selection_name) %>%
adjust_pvalue(method = "bonferroni") %>%
add_significance() %>%
add_xy_position(x="selection_name",step.increase=1)
#stat.test$manual_position <- stat.test$y.position * .5
#stat.test$manual_position <- c(110, 150, 170, 170, 130, 110)
stat.test$label <- mapply(p_label,stat.test$p.adj)ggplot(
final_data,
aes(
x=selection_name,
y=max_performance,
fill=selection_name
)
) +
geom_boxplot() +
scale_y_continuous(
name="Average trait performance"
) +
scale_x_discrete(
name="Selection"
) +
scale_fill_discrete(
name="Selection"
) +
scale_color_discrete(
name="Selection"
) +
theme(legend.position="none") +
facet_wrap(~problem_name, scales="free")
stat.test %>%
kbl() %>%
kable_styling(
bootstrap_options = c(
"striped",
"hover",
"condensed",
"responsive"
)
) %>%
scroll_box(width="600px")| .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | y.position | groups | xmin | xmax | label |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| max_performance | Eco-EA | Fitness sharing | 240 | 240 | 28441.0 | 8.13e-01 | 1.00e+00 | ns | 92373.4 | Eco-EA , Fitness sharing | 1 | 2 | p = 1 |
| max_performance | Eco-EA | Lexicase | 240 | 240 | 22922.0 | 9.76e-05 | 9.76e-04 | *** | 123659.5 | Eco-EA , Lexicase | 1 | 3 | p = 0.000976 |
| max_performance | Eco-EA | Random | 240 | 240 | 38538.5 | 0.00e+00 | 0.00e+00 | **** | 154945.6 | Eco-EA, Random | 1 | 4 | p < 1e-04 |
| max_performance | Eco-EA | Tournament | 240 | 240 | 28012.5 | 6.04e-01 | 1.00e+00 | ns | 186231.7 | Eco-EA , Tournament | 1 | 5 | p = 1 |
| max_performance | Fitness sharing | Lexicase | 240 | 240 | 21780.0 | 3.70e-06 | 3.74e-05 | **** | 217517.8 | Fitness sharing, Lexicase | 2 | 3 | p < 1e-04 |
| max_performance | Fitness sharing | Random | 240 | 240 | 40057.0 | 0.00e+00 | 0.00e+00 | **** | 248804.0 | Fitness sharing, Random | 2 | 4 | p < 1e-04 |
| max_performance | Fitness sharing | Tournament | 240 | 240 | 26440.5 | 1.20e-01 | 1.00e+00 | ns | 280090.1 | Fitness sharing, Tournament | 2 | 5 | p = 1 |
| max_performance | Lexicase | Random | 240 | 240 | 42908.5 | 0.00e+00 | 0.00e+00 | **** | 311376.2 | Lexicase, Random | 3 | 4 | p < 1e-04 |
| max_performance | Lexicase | Tournament | 240 | 240 | 34451.5 | 1.92e-04 | 1.92e-03 | ** | 342662.3 | Lexicase , Tournament | 3 | 5 | p = 0.00192 |
| max_performance | Random | Tournament | 240 | 240 | 17806.0 | 0.00e+00 | 0.00e+00 | **** | 373948.4 | Random , Tournament | 4 | 5 | p < 1e-04 |
Phylogenetic diversity
Relationship between different types of pylogenetic diversity
First, to get a big-picture overview, we make correlation matrices of all the different phylogenetic diversity metrics:
final_data %>%
transmute(MinPD=min_phenotype_pairwise_distance,
MeanPD=mean_phenotype_pairwise_distance,
MaxPD=max_phenotype_pairwise_distance,
VarPD=variance_phenotype_pairwise_distance,
MinED = min_phenotype_evolutionary_distinctiveness,
MeanED= mean_phenotype_evolutionary_distinctiveness,
MaxED=max_phenotype_evolutionary_distinctiveness,
VarED=variance_phenotype_evolutionary_distinctiveness,
PD=phenotype_current_phylogenetic_diversity, # See Faith 1992
MRCA=phenotype_mrca_depth, # Phylogenetic depth of most recent common ancestor
N=phenotype_num_taxa # Number of taxonomically-distinct phenotypes
) %>%
cor_mat() %>%
pull_lower_triangle() %>%
cor_plot()
However, these correlations may well vary by selection scheme and by problem, and even over time within a selection scheme and problem. Let’s take a look at some scatter plots.
ggplot(
data %>% filter(generation==1000),
aes(
y=mean_phenotype_pairwise_distance,
x=variance_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==1000),
aes(
y=mean_phenotype_pairwise_distance,
x=max_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==1000),
aes(
y=variance_phenotype_pairwise_distance,
x=max_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==500),
aes(
y=mean_phenotype_pairwise_distance,
x=variance_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==500),
aes(
y=mean_phenotype_pairwise_distance,
x=max_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==1000),
aes(
y=variance_phenotype_pairwise_distance,
x=max_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==1000),
aes(
y=mean_phenotype_evolutionary_distinctiveness,
x=variance_phenotype_evolutionary_distinctiveness,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==1000),
aes(
y=mean_phenotype_evolutionary_distinctiveness,
x=max_phenotype_evolutionary_distinctiveness,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==1000),
aes(
y=mean_phenotype_evolutionary_distinctiveness,
x=min_phenotype_evolutionary_distinctiveness,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==500),
aes(
y=mean_phenotype_evolutionary_distinctiveness,
x=variance_phenotype_evolutionary_distinctiveness,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==500),
aes(
y=mean_phenotype_evolutionary_distinctiveness,
x=max_phenotype_evolutionary_distinctiveness,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==500),
aes(
y=mean_phenotype_evolutionary_distinctiveness,
x=min_phenotype_evolutionary_distinctiveness,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_x_continuous(
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
Over time
ggplot(
data,
aes(
x=generation,
y=mean_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
stat_summary(geom="line", fun=mean) +
stat_summary(
geom="ribbon",
fun.data="mean_cl_boot",
fun.args=list(conf.int=0.95),
alpha=0.2,
linetype=0
) +
scale_y_log10(
name="Mean pairwise distance"
) +
scale_x_continuous(
name="Generation"
) +
scale_color_discrete("Selection") +
scale_fill_discrete("Selection") +
facet_wrap(~problem_name, scales = "free")
Final
# Compute manual labels for geom_signif
stat.test <- final_data %>%
wilcox_test(mean_phenotype_pairwise_distance ~ selection_name) %>%
adjust_pvalue(method = "bonferroni") %>%
add_significance() %>%
add_xy_position(x="selection_name",step.increase=1)
#stat.test$manual_position <- stat.test$y.position * .5
#stat.test$manual_position <- c(110, 150, 170, 170, 130, 110)
stat.test$label <- mapply(p_label,stat.test$p.adj)ggplot(
final_data,
aes(
x=selection_name,
y=mean_phenotype_pairwise_distance,
fill=selection_name
)
) +
geom_boxplot() +
scale_y_log10(
name="Mean pairwise distance"
) +
scale_x_discrete(
name="Selection"
) +
scale_fill_discrete(
name="Selection"
) +
scale_color_discrete(
name="Selection"
) +
theme(legend.position = "none") +
facet_wrap(~problem_name, scales = "free")
stat.test %>%
kbl() %>%
kable_styling(
bootstrap_options = c(
"striped",
"hover",
"condensed",
"responsive"
)
) %>%
scroll_box(width="600px")| .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | y.position | groups | xmin | xmax | label |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| mean_phenotype_pairwise_distance | Eco-EA | Fitness sharing | 240 | 240 | 3511.0 | 0.00e+00 | 0.00e+00 | **** | 947.655 | Eco-EA , Fitness sharing | 1 | 2 | p < 1e-04 |
| mean_phenotype_pairwise_distance | Eco-EA | Lexicase | 240 | 240 | 20909.0 | 2.00e-07 | 2.10e-06 | **** | 1454.357 | Eco-EA , Lexicase | 1 | 3 | p < 1e-04 |
| mean_phenotype_pairwise_distance | Eco-EA | Random | 240 | 240 | 9748.0 | 0.00e+00 | 0.00e+00 | **** | 1961.059 | Eco-EA, Random | 1 | 4 | p < 1e-04 |
| mean_phenotype_pairwise_distance | Eco-EA | Tournament | 240 | 240 | 43540.5 | 0.00e+00 | 0.00e+00 | **** | 2467.762 | Eco-EA , Tournament | 1 | 5 | p < 1e-04 |
| mean_phenotype_pairwise_distance | Fitness sharing | Lexicase | 240 | 240 | 34153.0 | 4.27e-04 | 4.27e-03 | ** | 2974.464 | Fitness sharing, Lexicase | 2 | 3 | p = 0.00427 |
| mean_phenotype_pairwise_distance | Fitness sharing | Random | 240 | 240 | 36413.0 | 5.00e-07 | 5.40e-06 | **** | 3481.166 | Fitness sharing, Random | 2 | 4 | p < 1e-04 |
| mean_phenotype_pairwise_distance | Fitness sharing | Tournament | 240 | 240 | 56652.0 | 0.00e+00 | 0.00e+00 | **** | 3987.868 | Fitness sharing, Tournament | 2 | 5 | p < 1e-04 |
| mean_phenotype_pairwise_distance | Lexicase | Random | 240 | 240 | 26709.5 | 1.69e-01 | 1.00e+00 | ns | 4494.571 | Lexicase, Random | 3 | 4 | p = 1 |
| mean_phenotype_pairwise_distance | Lexicase | Tournament | 240 | 240 | 39183.5 | 0.00e+00 | 0.00e+00 | **** | 5001.273 | Lexicase , Tournament | 3 | 5 | p < 1e-04 |
| mean_phenotype_pairwise_distance | Random | Tournament | 240 | 240 | 54896.0 | 0.00e+00 | 0.00e+00 | **** | 5507.975 | Random , Tournament | 4 | 5 | p < 1e-04 |
Phenotypic diversity
Relationship between different types of phenotypic diversity
First, we should assess the extent to which different metrics of phenotypic diversity are capturing different information.
ggplot(
data %>% filter(generation==1000),
aes(
y=phenotype_diversity,
x=phenotype_num_taxa,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_y_continuous(
name="Phenotypic shannon diversity"
) +
scale_x_continuous(
name="Phenotypic richness",
breaks = breaks_extended(4)
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
Over time
ggplot(
data,
aes(
x=generation,
y=phenotype_num_taxa,
color=selection_name,
fill=selection_name
)
) +
stat_summary(geom="line", fun=mean) +
stat_summary(
geom="ribbon",
fun.data="mean_cl_boot",
fun.args=list(conf.int=0.95),
alpha=0.2,
linetype=0
) +
scale_y_continuous(
name="Phenotypic richness"
) +
scale_x_continuous(
name="Generation"
) +
scale_color_discrete("Selection") +
scale_fill_discrete("Selection") +
facet_wrap(~problem_name, scales = "free")
Final
# Compute manual labels for geom_signif
stat.test <- final_data %>%
wilcox_test(phenotype_num_taxa ~ selection_name) %>%
adjust_pvalue(method = "bonferroni") %>%
add_significance() %>%
add_xy_position(x="selection_name",step.increase=1)
#stat.test$manual_position <- stat.test$y.position * .5
#stat.test$manual_position <- c(110, 150, 170, 170, 130, 110)
stat.test$label <- mapply(p_label,stat.test$p.adj)ggplot(
final_data,
aes(
x=selection_name,
y=phenotype_num_taxa,
fill=selection_name
)
) +
geom_boxplot() +
scale_y_continuous(
name="Phenotypic Richness"
) +
scale_x_discrete(
name="Selection"
) +
scale_fill_discrete(
name="Selection"
) +
scale_color_discrete(
name="Selection"
) +
theme(legend.position = "none") +
facet_wrap(~problem_name, scales = "free")
stat.test %>%
kbl() %>%
kable_styling(
bootstrap_options = c(
"striped",
"hover",
"condensed",
"responsive"
)
) %>%
scroll_box(width="600px")| .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | y.position | groups | xmin | xmax | label |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| phenotype_num_taxa | Eco-EA | Fitness sharing | 240 | 240 | 4821.5 | 0.00e+00 | 0.0e+00 | **** | 1575.000 | Eco-EA , Fitness sharing | 1 | 2 | p < 1e-04 |
| phenotype_num_taxa | Eco-EA | Lexicase | 240 | 240 | 18116.5 | 0.00e+00 | 0.0e+00 | **** | 2217.222 | Eco-EA , Lexicase | 1 | 3 | p < 1e-04 |
| phenotype_num_taxa | Eco-EA | Random | 240 | 240 | 39069.0 | 0.00e+00 | 0.0e+00 | **** | 2859.444 | Eco-EA, Random | 1 | 4 | p < 1e-04 |
| phenotype_num_taxa | Eco-EA | Tournament | 240 | 240 | 30286.5 | 3.28e-01 | 1.0e+00 | ns | 3501.667 | Eco-EA , Tournament | 1 | 5 | p = 1 |
| phenotype_num_taxa | Fitness sharing | Lexicase | 240 | 240 | 38253.5 | 0.00e+00 | 0.0e+00 | **** | 4143.889 | Fitness sharing, Lexicase | 2 | 3 | p < 1e-04 |
| phenotype_num_taxa | Fitness sharing | Random | 240 | 240 | 56565.5 | 0.00e+00 | 0.0e+00 | **** | 4786.111 | Fitness sharing, Random | 2 | 4 | p < 1e-04 |
| phenotype_num_taxa | Fitness sharing | Tournament | 240 | 240 | 48493.0 | 0.00e+00 | 0.0e+00 | **** | 5428.333 | Fitness sharing, Tournament | 2 | 5 | p < 1e-04 |
| phenotype_num_taxa | Lexicase | Random | 240 | 240 | 47962.0 | 0.00e+00 | 0.0e+00 | **** | 6070.556 | Lexicase, Random | 3 | 4 | p < 1e-04 |
| phenotype_num_taxa | Lexicase | Tournament | 240 | 240 | 41159.0 | 0.00e+00 | 0.0e+00 | **** | 6712.778 | Lexicase , Tournament | 3 | 5 | p < 1e-04 |
| phenotype_num_taxa | Random | Tournament | 240 | 240 | 21888.0 | 5.40e-06 | 5.4e-05 | **** | 7355.000 | Random , Tournament | 4 | 5 | p < 1e-04 |
Relationship between phenotypic and phylogenetic diversity
ggplot(
final_data,
aes(
y=phenotype_num_taxa,
x=mean_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_y_continuous(
name="Phenotypic richness"
) +
scale_x_continuous(
name="Mean pairwise distance"
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
Relationship between diversity and success
Earlier in run
ggplot(
data %>% filter(generation==500),
aes(
y=max_performance,
x=mean_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_y_continuous(
name="Average trait performance"
) +
scale_x_continuous(
name="Mean pairwise distance"
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
data %>% filter(generation==500),
aes(
y=max_performance,
x=phenotype_num_taxa,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_y_continuous(
name="Average trait performance"
) +
scale_x_continuous(
name="Phenotypic richness"
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
phylogney_vs_performance <- ggplot(
data %>% filter(generation==1000),
aes(
y=max_performance,
x=mean_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_y_continuous(
name="Average trait performance"
) +
scale_x_continuous(
name="Mean pairwise distance"
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
phylogney_vs_performance
ggplot(
data %>% filter(generation==1000),
aes(
y=max_performance,
x=phenotype_num_taxa,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_y_continuous(
name="Average trait performance"
) +
scale_x_continuous(
name="Phenotypic richness"
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
End of run
ggplot(
final_data,
aes(
y=max_performance,
x=mean_phenotype_pairwise_distance,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_y_continuous(
name="Average trait performance"
) +
scale_x_continuous(
name="Mean pairwise distance"
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
ggplot(
final_data,
aes(
y=max_performance,
x=phenotype_num_taxa,
color=selection_name,
fill=selection_name
)
) +
geom_point() +
scale_y_continuous(
name="Average trait performance"
) +
scale_x_continuous(
name="Phenotypic richness"
) +
facet_wrap(
~selection_name*problem_name, scales="free"
) +
stat_smooth(
method="lm"
) +
stat_cor(
method="spearman", cor.coef.name = "rho", color="black"
) +
theme(legend.position = "none")
Causality analysis
Setup
First let’s define a function we’ll use to calculate and output significance and effect size for these results:
transfer_entropy_stats <- function(res) {
stat.test <- res %>%
group_by(selection_name, offset) %>%
wilcox_test(value ~ Type) %>%
adjust_pvalue(method = "bonferroni") %>%
add_significance()
stat.test$label <- mapply(p_label,stat.test$p.adj)
# Calculate effect sizes for these differences
effect_sizes <- res %>%
group_by(selection_name, offset) %>%
wilcox_effsize(value ~ Type)
stat.test$effsize <- effect_sizes$effsize
stat.test$magnitude <- effect_sizes$magnitude
stat.test %>%
kbl() %>%
kable_styling(
bootstrap_options = c(
"striped",
"hover",
"condensed",
"responsive"
)
) %>%
scroll_box()
}Transfer entropy from diversity to fitness
Max pairwise distance vs. phenotypic richness
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
fit_phylo_10 = condinformation(discretize(max_performance), discretize(lag(max_phenotype_pairwise_distance, 1)), discretize(lag(max_performance, 1))),
fit_phylo_100 = condinformation(discretize(max_performance), discretize(lag(max_phenotype_pairwise_distance, 10)), discretize(lag(max_performance, 10))),
fit_phylo_500 = condinformation(discretize(max_performance), discretize(lag(max_phenotype_pairwise_distance, 50)), discretize(lag(max_performance, 50))),
fit_pheno_10 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 1)), discretize(lag(max_performance, 1))),
fit_pheno_100 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 10)), discretize(lag(max_performance, 10))),
fit_pheno_500 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 50)), discretize(lag(max_performance, 50)))
)
res <- res %>% pivot_longer(cols=contains("o_10"))
res$offset <- str_extract(res$name, "[:digit:]*$")
res$Type <- case_when(str_detect(res$name, "phylo") ~ "Phylogenetic", TRUE ~ "Phenotypic")
ggplot(
res %>% filter(str_detect(name, "fit_ph*")),
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~problem_name*selection_name) +
scale_x_discrete("Lag") +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("") +
theme(legend.position = "bottom")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27721.5 | 0.478000 | 1.00000 | ns | p = 1 | 0.0323987 | small |
| Eco-EA | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 25260.0 | 0.019800 | 0.19800 | ns | p = 0.198 | 0.1063385 | small |
| Fitness sharing | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 25411.0 | 0.025700 | 0.25700 | ns | p = 0.257 | 0.1018024 | small |
| Fitness sharing | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 18873.0 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.2981978 | small |
| Lexicase | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28721.5 | 0.959000 | 1.00000 | ns | p = 1 | 0.0023758 | small |
| Lexicase | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 22943.0 | 0.000103 | 0.00103 | ** | p = 0.00103 | 0.1772604 | small |
| Random | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27780.5 | 0.502000 | 1.00000 | ns | p = 1 | 0.0306766 | small |
| Random | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 24742.0 | 0.007480 | 0.07480 | ns | p = 0.0748 | 0.1221047 | small |
| Tournament | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 29185.0 | 0.799000 | 1.00000 | ns | p = 1 | 0.0116433 | small |
| Tournament | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 27464.0 | 0.377000 | 1.00000 | ns | p = 1 | 0.0403627 | small |
Mean pairwise distance vs. phenotypic richness
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
fit_phylo_10 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_pairwise_distance, 1)), discretize(lag(max_performance, 1))),
fit_phylo_100 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_pairwise_distance, 10)), discretize(lag(max_performance, 10))),
fit_phylo_500 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_pairwise_distance, 50)), discretize(lag(max_performance, 50))),
fit_pheno_10 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 1)), discretize(lag(max_performance, 1))),
fit_pheno_100 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 10)), discretize(lag(max_performance, 10))),
fit_pheno_500 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 50)), discretize(lag(max_performance, 50)))
)
res <- res %>% pivot_longer(cols=contains("o_10"))
res$offset <- str_extract(res$name, "[:digit:]*$")
res$Type <- case_when(str_detect(res$name, "phylo") ~ "Phylogenetic", TRUE ~ "Phenotypic")
ggplot(
res %>% filter(str_detect(name, "fit_ph*")),
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~problem_name*selection_name) +
scale_x_discrete("Lag") +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("") +
theme(legend.position = "bottom")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27824.0 | 0.521000 | 1.00000 | ns | p = 1 | 0.0293196 | small |
| Eco-EA | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 25774.5 | 0.046500 | 0.46500 | ns | p = 0.465 | 0.0908834 | small |
| Fitness sharing | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 25570.0 | 0.033600 | 0.33600 | ns | p = 0.336 | 0.0970262 | small |
| Fitness sharing | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 18806.0 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.3002104 | moderate |
| Lexicase | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28316.5 | 0.749000 | 1.00000 | ns | p = 1 | 0.0146330 | small |
| Lexicase | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 23267.5 | 0.000244 | 0.00244 | ** | p = 0.00244 | 0.1674395 | small |
| Random | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27609.5 | 0.433000 | 1.00000 | ns | p = 1 | 0.0358220 | small |
| Random | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 26008.5 | 0.065800 | 0.65800 | ns | p = 0.658 | 0.0839959 | small |
| Tournament | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28652.5 | 0.922000 | 1.00000 | ns | p = 1 | 0.0044607 | small |
| Tournament | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 26073.0 | 0.071100 | 0.71100 | ns | p = 0.711 | 0.0823870 | small |
Mean pairwise distance vs. phenotypic Shannon diversity
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
fit_phylo_10 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_pairwise_distance, 1)), discretize(lag(max_performance, 1))),
fit_phylo_100 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_pairwise_distance, 10)), discretize(lag(max_performance, 10))),
fit_phylo_500 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_pairwise_distance, 50)), discretize(lag(max_performance, 50))),
fit_pheno_10 = condinformation(discretize(max_performance), discretize(lag(phenotype_diversity, 1)), discretize(lag(max_performance, 1))),
fit_pheno_100 = condinformation(discretize(max_performance), discretize(lag(phenotype_diversity, 10)), discretize(lag(max_performance, 10))),
fit_pheno_500 = condinformation(discretize(max_performance), discretize(lag(phenotype_diversity, 50)), discretize(lag(max_performance, 50)))
)
res <- res %>% pivot_longer(cols=contains("o_10"))
res$offset <- str_extract(res$name, "[:digit:]*$")
res$Type <- case_when(str_detect(res$name, "phylo") ~ "Phylogenetic", TRUE ~ "Phenotypic")
ggplot(
res %>% filter(str_detect(name, "fit_ph*")),
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~problem_name*selection_name) +
scale_x_discrete("Lag") +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("") +
theme(legend.position = "bottom")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28432.0 | 0.809000 | 1.00000 | ns | p = 1 | 0.0110549 | small |
| Eco-EA | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 25094.5 | 0.014800 | 0.14800 | ns | p = 0.148 | 0.1113101 | small |
| Fitness sharing | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 25665.0 | 0.039100 | 0.39100 | ns | p = 0.391 | 0.0941725 | small |
| Fitness sharing | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 18866.0 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.2984080 | small |
| Lexicase | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27887.0 | 0.545000 | 1.00000 | ns | p = 1 | 0.0276317 | small |
| Lexicase | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 23061.5 | 0.000142 | 0.00142 | ** | p = 0.00142 | 0.1736740 | small |
| Random | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27546.0 | 0.409000 | 1.00000 | ns | p = 1 | 0.0377329 | small |
| Random | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 27250.5 | 0.307000 | 1.00000 | ns | p = 1 | 0.0466243 | small |
| Tournament | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28662.0 | 0.927000 | 1.00000 | ns | p = 1 | 0.0041734 | small |
| Tournament | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 27121.5 | 0.267000 | 1.00000 | ns | p = 1 | 0.0507102 | small |
Mean evolutionary distinctiveness vs. phenotypic richness
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
fit_phylo_10 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_evolutionary_distinctiveness, 1)), discretize(lag(max_performance, 1))),
fit_phylo_100 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_evolutionary_distinctiveness, 10)), discretize(lag(max_performance, 10))),
fit_phylo_500 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_evolutionary_distinctiveness, 50)), discretize(lag(max_performance, 50))),
fit_pheno_10 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 1)), discretize(lag(max_performance, 1))),
fit_pheno_100 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 10)), discretize(lag(max_performance, 10))),
fit_pheno_500 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 50)), discretize(lag(max_performance, 50)))
)
res <- res %>% pivot_longer(cols=contains("o_10"))
res$offset <- str_extract(res$name, "[:digit:]*$")
res$Type <- case_when(str_detect(res$name, "phylo") ~ "Phylogenetic", TRUE ~ "Phenotypic")
ggplot(
res %>% filter(str_detect(name, "fit_ph*")),
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~problem_name*selection_name) +
scale_x_discrete("Lag") +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("") +
theme(legend.position = "bottom")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27071.5 | 2.55e-01 | 1.000000 | ns | p = 1 | 0.0519251 | small |
| Eco-EA | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 24236.0 | 2.67e-03 | 0.026700 |
|
p = 0.0267 | 0.1370986 | small |
| Fitness sharing | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 26368.0 | 1.10e-01 | 1.000000 | ns | p = 1 | 0.0730550 | small |
| Fitness sharing | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 24482.0 | 4.49e-03 | 0.044900 |
|
p = 0.0449 | 0.1297087 | small |
| Lexicase | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 29278.0 | 7.52e-01 | 1.000000 | ns | p = 1 | 0.0144665 | small |
| Lexicase | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 23573.5 | 5.30e-04 | 0.005300 | ** | p = 0.0053 | 0.1581785 | small |
| Random | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28256.0 | 7.20e-01 | 1.000000 | ns | p = 1 | 0.0163689 | small |
| Random | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 27327.0 | 3.32e-01 | 1.000000 | ns | p = 1 | 0.0443224 | small |
| Tournament | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28964.5 | 9.13e-01 | 1.000000 | ns | p = 1 | 0.0049749 | small |
| Tournament | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 22758.0 | 6.36e-05 | 0.000636 | *** | p = 0.000636 | 0.1825385 | small |
Mean evolutionary distinctiveness vs. phenotypic Shannon diveristy
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
fit_phylo_10 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_evolutionary_distinctiveness, 1)), discretize(lag(max_performance, 1))),
fit_phylo_100 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_evolutionary_distinctiveness, 10)), discretize(lag(max_performance, 10))),
fit_phylo_500 = condinformation(discretize(max_performance), discretize(lag(mean_phenotype_evolutionary_distinctiveness, 50)), discretize(lag(max_performance, 50))),
fit_pheno_10 = condinformation(discretize(max_performance), discretize(lag(phenotype_diversity, 1)), discretize(lag(max_performance, 1))),
fit_pheno_100 = condinformation(discretize(max_performance), discretize(lag(phenotype_diversity, 10)), discretize(lag(max_performance, 10))),
fit_pheno_500 = condinformation(discretize(max_performance), discretize(lag(phenotype_diversity, 50)), discretize(lag(max_performance, 50)))
)
res <- res %>% pivot_longer(cols=contains("o_10"))
res$offset <- str_extract(res$name, "[:digit:]*$")
res$Type <- case_when(str_detect(res$name, "phylo") ~ "Phylogenetic", TRUE ~ "Phenotypic")
ggplot(
res %>% filter(str_detect(name, "fit_ph*")),
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~problem_name*selection_name) +
scale_x_discrete("Lag") +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("") +
theme(legend.position = "bottom")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27878.0 | 0.544000 | 1.00000 | ns | p = 1 | 0.0276974 | small |
| Eco-EA | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 24139.5 | 0.002160 | 0.02160 |
|
p = 0.0216 | 0.1399975 | small |
| Fitness sharing | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 26469.0 | 0.125000 | 1.00000 | ns | p = 1 | 0.0700210 | small |
| Fitness sharing | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 24377.0 | 0.003610 | 0.03610 |
|
p = 0.0361 | 0.1328628 | small |
| Lexicase | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28847.5 | 0.975000 | 1.00000 | ns | p = 1 | 0.0014376 | small |
| Lexicase | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 23292.5 | 0.000261 | 0.00261 | ** | p = 0.00261 | 0.1666828 | small |
| Random | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28179.0 | 0.682000 | 1.00000 | ns | p = 1 | 0.0186861 | small |
| Random | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 28542.5 | 0.865000 | 1.00000 | ns | p = 1 | 0.0077482 | small |
| Tournament | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28976.5 | 0.907000 | 1.00000 | ns | p = 1 | 0.0053378 | small |
| Tournament | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 23925.0 | 0.001250 | 0.01250 |
|
p = 0.0125 | 0.1472815 | small |
Variance evolutionary distinctiveness vs. phenotypic richness
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
fit_phylo_10 = condinformation(discretize(max_performance), discretize(lag(variance_phenotype_evolutionary_distinctiveness, 1)), discretize(lag(max_performance, 1))),
fit_phylo_100 = condinformation(discretize(max_performance), discretize(lag(variance_phenotype_evolutionary_distinctiveness, 10)), discretize(lag(max_performance, 10))),
fit_phylo_500 = condinformation(discretize(max_performance), discretize(lag(variance_phenotype_evolutionary_distinctiveness, 50)), discretize(lag(max_performance, 50))),
fit_pheno_10 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 1)), discretize(lag(max_performance, 1))),
fit_pheno_100 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 10)), discretize(lag(max_performance, 10))),
fit_pheno_500 = condinformation(discretize(max_performance), discretize(lag(phenotype_num_taxa, 50)), discretize(lag(max_performance, 50)))
)
res <- res %>% pivot_longer(cols=contains("o_10"))
res$offset <- str_extract(res$name, "[:digit:]*$")
res$Type <- case_when(str_detect(res$name, "phylo") ~ "Phylogenetic", TRUE ~ "Phenotypic")
ggplot(
res %>% filter(str_detect(name, "fit_ph*")),
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~problem_name*selection_name) +
scale_x_discrete("Lag") +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("") +
theme(legend.position = "bottom")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27618.0 | 0.43700 | 1.0000 | ns | p = 1 | 0.0355079 | small |
| Eco-EA | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 24904.5 | 0.01040 | 0.1040 | ns | p = 0.104 | 0.1170174 | small |
| Fitness sharing | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 27307.0 | 0.32600 | 1.0000 | ns | p = 1 | 0.0448483 | small |
| Fitness sharing | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 28643.0 | 0.91800 | 1.0000 | ns | p = 1 | 0.0047161 | small |
| Lexicase | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28782.5 | 0.99100 | 1.0000 | ns | p = 1 | 0.0005296 | small |
| Lexicase | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 25088.0 | 0.01390 | 0.1390 | ns | p = 0.139 | 0.1123426 | small |
| Random | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 29327.0 | 0.72900 | 1.0000 | ns | p = 1 | 0.0158574 | small |
| Random | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 28087.5 | 0.63900 | 1.0000 | ns | p = 1 | 0.0214390 | small |
| Tournament | 10 | value | Phenotypic | Phylogenetic | 240 | 240 | 28982.5 | 0.90400 | 1.0000 | ns | p = 1 | 0.0055192 | small |
| Tournament | 100 | value | Phenotypic | Phylogenetic | 240 | 240 | 24187.0 | 0.00227 | 0.0227 |
|
p = 0.0227 | 0.1393661 | small |
Transfer entropy between types of diversity
While we’re calculating transfer entropy, we might as well also calculate it between phenotypic diversity and phylogenetic diversity, as these could potentially also be in a feedback loop.
Max pairwise distance and phenotypic richness
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
phen_phylo_10 = condinformation(discretize(phenotype_num_taxa),
discretize(lag(max_phenotype_pairwise_distance, 1)),
discretize(lag(phenotype_num_taxa, 1))),
phen_phylo_100 = condinformation(discretize(phenotype_num_taxa),
discretize(lag(max_phenotype_pairwise_distance, 10)),
discretize(lag(phenotype_num_taxa, 10))),
pheno_phylo_500 = condinformation(discretize(phenotype_num_taxa),
discretize(lag(max_phenotype_pairwise_distance, 50)),
discretize(lag(phenotype_num_taxa, 50))),
phylo_pheno_10 = condinformation(discretize(max_phenotype_pairwise_distance),
discretize(lag(phenotype_num_taxa, 1)),
discretize(lag(max_phenotype_pairwise_distance, 1))),
phylo_pheno_100 = condinformation(discretize(max_phenotype_pairwise_distance),
discretize(lag(phenotype_num_taxa, 10)),
discretize(lag(max_phenotype_pairwise_distance, 10))),
phylo_pheno_500 = condinformation(discretize(max_phenotype_pairwise_distance),
discretize(lag(phenotype_num_taxa, 50)),
discretize(lag(max_phenotype_pairwise_distance, 50))))
# Turn Transfer Entropy columns into rows
res <- res %>% pivot_longer(cols=contains("phylo"))
# Pull lag into a column
res$offset <- str_extract(res$name, "[:digit:]*$")
# Make column indicating direction of transfer entropy
res$Type <- case_when(str_detect(res$name, "phylo_pheno") ~ "\nPhenotypic\n\t->\nPhylogenetic\n", TRUE ~ "\nPhylogenetic\n\t->\nPhenotypic\n")
ggplot(
res,
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~selection_name* problem_name) +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 6958 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.6561130 | large |
| Eco-EA | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 14855 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.4188946 | moderate |
| Eco-EA | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 21575 | 2.00e-06 | 0.0000299 | **** | p < 1e-04 | 0.2170322 | small |
| Fitness sharing | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 2925 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.7772605 | large |
| Fitness sharing | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 20851 | 2.00e-07 | 0.0000025 | **** | p < 1e-04 | 0.2387804 | small |
| Fitness sharing | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 22621 | 4.78e-05 | 0.0007170 | *** | p = 0.000717 | 0.1856113 | small |
| Lexicase | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 6761 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.6620307 | large |
| Lexicase | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 12450 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.4911385 | moderate |
| Lexicase | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 15778 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.3914964 | moderate |
| Random | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 2011 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.8047162 | large |
| Random | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 3736 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.7528988 | large |
| Random | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 6272 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.6767198 | large |
| Tournament | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 21406 | 1.10e-06 | 0.0000171 | **** | p < 1e-04 | 0.2221088 | small |
| Tournament | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 30069 | 4.04e-01 | 1.0000000 | ns | p = 1 | 0.0381196 | small |
| Tournament | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 25468 | 2.83e-02 | 0.4245000 | ns | p = 0.4245 | 0.1000901 | small |
Mean pairwise distance and phenotypic richness
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
phen_phylo_10 = condinformation(discretize(phenotype_num_taxa),
discretize(lag(mean_phenotype_pairwise_distance, 1)),
discretize(lag(phenotype_num_taxa, 1))),
phen_phylo_100 = condinformation(discretize(phenotype_num_taxa),
discretize(lag(mean_phenotype_pairwise_distance, 10)),
discretize(lag(phenotype_num_taxa, 10))),
pheno_phylo_500 = condinformation(discretize(phenotype_num_taxa),
discretize(lag(mean_phenotype_pairwise_distance, 50)),
discretize(lag(phenotype_num_taxa, 50))),
phylo_pheno_10 = condinformation(discretize(mean_phenotype_pairwise_distance),
discretize(lag(phenotype_num_taxa, 1)),
discretize(lag(mean_phenotype_pairwise_distance, 1))),
phylo_pheno_100 = condinformation(discretize(mean_phenotype_pairwise_distance),
discretize(lag(phenotype_num_taxa, 10)),
discretize(lag(mean_phenotype_pairwise_distance, 10))),
phylo_pheno_500 = condinformation(discretize(mean_phenotype_pairwise_distance),
discretize(lag(phenotype_num_taxa, 50)),
discretize(lag(mean_phenotype_pairwise_distance, 50)))
)
# Turn Transfer Entropy columns into rows
res <- res %>% pivot_longer(cols=contains("phylo"))
# Pull lag into a column
res$offset <- str_extract(res$name, "[:digit:]*$")
# Make column indicating direction of transfer entropy
res$Type <- case_when(str_detect(res$name, "phylo_pheno") ~ "\nPhenotypic\n\t->\nPhylogenetic\n", TRUE ~ "\nPhylogenetic\n\t->\nPhenotypic\n")
ggplot(
res,
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~selection_name*problem_name) +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 6847 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.6594473 | large |
| Eco-EA | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 19033 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.2933914 | small |
| Eco-EA | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 25539 | 3.19e-02 | 0.4785000 | ns | p = 0.4785 | 0.0979573 | small |
| Fitness sharing | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 2456 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.7913488 | large |
| Fitness sharing | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 22770 | 7.24e-05 | 0.0010860 | ** | p = 0.001086 | 0.1811355 | small |
| Fitness sharing | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 22528 | 3.67e-05 | 0.0005505 | *** | p = 0.0005505 | 0.1884049 | small |
| Lexicase | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 13879 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.4482525 | moderate |
| Lexicase | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 15973 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.3853350 | moderate |
| Lexicase | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 17781 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.3310011 | moderate |
| Random | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 3809 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.7507060 | large |
| Random | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 6568 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.6678282 | large |
| Random | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 6557 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.6681586 | large |
| Tournament | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 10956 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.5360168 | large |
| Tournament | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 30938 | 1.60e-01 | 1.0000000 | ns | p = 1 | 0.0642235 | small |
| Tournament | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 29992 | 4.33e-01 | 1.0000000 | ns | p = 1 | 0.0358066 | small |
Mean pairwise distance and shannon diversity
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
phen_phylo_10 = condinformation(discretize(phenotype_diversity),
discretize(lag(mean_phenotype_pairwise_distance, 1)),
discretize(lag(phenotype_diversity, 1))),
phen_phylo_100 = condinformation(discretize(phenotype_diversity),
discretize(lag(mean_phenotype_pairwise_distance, 10)),
discretize(lag(phenotype_diversity, 10))),
pheno_phylo_500 = condinformation(discretize(phenotype_diversity),
discretize(lag(mean_phenotype_pairwise_distance, 50)),
discretize(lag(phenotype_diversity, 50))),
phylo_pheno_10 = condinformation(discretize(mean_phenotype_pairwise_distance),
discretize(lag(phenotype_diversity, 1)),
discretize(lag(mean_phenotype_pairwise_distance, 1))),
phylo_pheno_100 = condinformation(discretize(mean_phenotype_pairwise_distance),
discretize(lag(phenotype_diversity, 10)),
discretize(lag(mean_phenotype_pairwise_distance, 10))),
phylo_pheno_500 = condinformation(discretize(mean_phenotype_pairwise_distance),
discretize(lag(phenotype_diversity, 50)),
discretize(lag(mean_phenotype_pairwise_distance, 50)))
)
# Turn Transfer Entropy columns into rows
res <- res %>% pivot_longer(cols=contains("phylo"))
# Pull lag into a column
res$offset <- str_extract(res$name, "[:digit:]*$")
# Make column indicating direction of transfer entropy
res$Type <- case_when(str_detect(res$name, "phylo_pheno") ~ "\nPhenotypic\n\t->\nPhylogenetic\n", TRUE ~ "\nPhylogenetic\n\t->\nPhenotypic\n")
ggplot(
res,
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~selection_name*problem_name) +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 15691 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.3937819 | moderate |
| Eco-EA | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 25886 | 5.52e-02 | 0.8280000 | ns | p = 0.828 | 0.0875338 | small |
| Eco-EA | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 28243 | 7.14e-01 | 1.0000000 | ns | p = 1 | 0.0167318 | small |
| Fitness sharing | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 2816 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.7805347 | large |
| Fitness sharing | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 22774 | 7.32e-05 | 0.0010980 | ** | p = 0.001098 | 0.1810153 | small |
| Fitness sharing | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 21905 | 5.70e-06 | 0.0000854 | **** | p < 1e-04 | 0.2071193 | small |
| Lexicase | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 15815 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.3912234 | moderate |
| Lexicase | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 18074 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.3230971 | moderate |
| Lexicase | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 18661 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.3046031 | moderate |
| Random | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 12767 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.4816161 | moderate |
| Random | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 11104 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.5315711 | large |
| Random | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 10826 | 0.00e+00 | 0.0000000 | **** | p < 1e-04 | 0.5399219 | large |
| Tournament | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 23366 | 3.49e-04 | 0.0052350 | ** | p = 0.005235 | 0.1632322 | small |
| Tournament | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 30523 | 2.57e-01 | 1.0000000 | ns | p = 1 | 0.0517573 | small |
| Tournament | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 28660 | 9.27e-01 | 1.0000000 | ns | p = 1 | 0.0042055 | small |
Mean evolutionary distinctiveness and phenotypic richness
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
phen_phylo_10 = condinformation(
discretize(phenotype_num_taxa),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 1)),
discretize(lag(phenotype_num_taxa, 1))),
phen_phylo_100 = condinformation(
discretize(phenotype_num_taxa),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 10)),
discretize(lag(phenotype_num_taxa, 10))),
pheno_phylo_500 = condinformation(
discretize(phenotype_num_taxa),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 50)),
discretize(lag(phenotype_num_taxa, 50))),
phylo_pheno_10 = condinformation(
discretize(mean_phenotype_evolutionary_distinctiveness),
discretize(lag(phenotype_num_taxa, 1)),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 1))),
phylo_pheno_100 = condinformation(
discretize(mean_phenotype_evolutionary_distinctiveness),
discretize(lag(phenotype_num_taxa, 10)),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 10))),
phylo_pheno_500 = condinformation(
discretize(mean_phenotype_evolutionary_distinctiveness),
discretize(lag(phenotype_num_taxa, 50)),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 50)))
)
# Turn Transfer Entropy columns into rows
res <- res %>% pivot_longer(cols=contains("phylo"))
# Pull lag into a column
res$offset <- str_extract(res$name, "[:digit:]*$")
# Make column indicating direction of transfer entropy
res$Type <- case_when(str_detect(res$name, "phylo_pheno") ~ "\nPhenotypic\n\t->\nPhylogenetic\n", TRUE ~ "\nPhylogenetic\n\t->\nPhenotypic\n")
ggplot(
res,
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~selection_name*problem_name) +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 934 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.8370682 | large |
| Eco-EA | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 9656 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.5750676 | large |
| Eco-EA | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 15734 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.3924903 | moderate |
| Fitness sharing | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 15338 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.4043857 | moderate |
| Fitness sharing | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 33694 | 0.001280 | 0.01920 |
|
p = 0.0192 | 0.1470111 | small |
| Fitness sharing | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 34436 | 0.000208 | 0.00312 | ** | p = 0.00312 | 0.1693001 | small |
| Lexicase | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 2492 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.7902674 | large |
| Lexicase | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 8305 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.6156504 | large |
| Lexicase | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 15244 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.4072094 | moderate |
| Random | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 9881 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.5683088 | large |
| Random | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 16097 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.3815861 | moderate |
| Random | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 18566 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.3074197 | moderate |
| Tournament | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 512 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.8497447 | large |
| Tournament | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 11177 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.5293782 | large |
| Tournament | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 16974 | 0.000000 | 0.00000 | **** | p < 1e-04 | 0.3552418 | moderate |
Mean evolutionary distinctiveness and shannon diversity
res <- data %>% group_by(SEED, selection_name, problem_name) %>%
summarise(
phen_phylo_10 = condinformation(
discretize(phenotype_diversity),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 1)),
discretize(lag(phenotype_diversity, 1))),
phen_phylo_100 = condinformation(
discretize(phenotype_diversity),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 10)),
discretize(lag(phenotype_diversity, 10))),
pheno_phylo_500 = condinformation(
discretize(phenotype_diversity),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 50)),
discretize(lag(phenotype_diversity, 50))),
phylo_pheno_10 = condinformation(
discretize(mean_phenotype_evolutionary_distinctiveness),
discretize(lag(phenotype_diversity, 1)),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 1))),
phylo_pheno_100 = condinformation(
discretize(mean_phenotype_evolutionary_distinctiveness),
discretize(lag(phenotype_diversity, 10)),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 10))),
phylo_pheno_500 = condinformation(
discretize(mean_phenotype_evolutionary_distinctiveness),
discretize(lag(phenotype_diversity, 50)),
discretize(lag(mean_phenotype_evolutionary_distinctiveness, 50)))
)
# Turn Transfer Entropy columns into rows
res <- res %>% pivot_longer(cols=contains("phylo"))
# Pull lag into a column
res$offset <- str_extract(res$name, "[:digit:]*$")
# Make column indicating direction of transfer entropy
res$Type <- case_when(str_detect(res$name, "phylo_pheno") ~ "\nPhenotypic\n\t->\nPhylogenetic\n", TRUE ~ "\nPhylogenetic\n\t->\nPhenotypic\n")
ggplot(
res,
aes(
x=as.factor(offset),
y=value,
color=Type
)
) +
geom_boxplot() +
facet_wrap(~selection_name*problem_name) +
scale_y_continuous("Transfer Entropy") +
scale_color_discrete("")
# Determine which conditions are significantly different from each other
transfer_entropy_stats(res)| selection_name | offset | .y. | group1 | group2 | n1 | n2 | statistic | p | p.adj | p.adj.signif | label | effsize | magnitude |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Eco-EA | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 2796 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.7811355 | large |
| Eco-EA | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 12134 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.5006308 | large |
| Eco-EA | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 16639 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.3653049 | moderate |
| Fitness sharing | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 15579 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.3971463 | moderate |
| Fitness sharing | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 34122 | 0.000461 | 0.0069150 | ** | p = 0.006915 | 0.1598678 | small |
| Fitness sharing | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 33296 | 0.003090 | 0.0463500 |
|
p = 0.04635 | 0.1350556 | small |
| Lexicase | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 2930 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.7771103 | large |
| Lexicase | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 9917 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.5672274 | large |
| Lexicase | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 15138 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.4103935 | moderate |
| Random | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 23749 | 0.000888 | 0.0133200 |
|
p = 0.01332 | 0.1517273 | small |
| Random | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 19170 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.2892761 | small |
| Random | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 20173 | 0.000000 | 0.0000002 | **** | p < 1e-04 | 0.2591469 | small |
| Tournament | 10 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 1996 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.8051668 | large |
| Tournament | 100 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 8604 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.6066687 | large |
| Tournament | 500 | value | Phenotypic -> Phylogenetic | Phylogenetic -> Phenotypic | 240 | 240 | 14842 | 0.000000 | 0.0000000 | **** | p < 1e-04 | 0.4192851 | moderate |